home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / scale.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  5KB  |  180 lines
  1. /* scale.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  12.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  13.          pivrel;
  14. } knstnt_;
  15.  
  16. #define knstnt_1 knstnt_
  17.  
  18. /*<       subroutine scale(xmin,xmax,n,xminp,xmaxp,del) >*/
  19. /* Subroutine */ int scale_(xmin, xmax, n, xminp, xmaxp, del)
  20. doublereal *xmin, *xmax;
  21. integer *n;
  22. doublereal *xminp, *xmaxp, *del;
  23. {
  24.     /* Initialized data */
  25.  
  26.     static doublereal vint[5] = { 1.,2.,5.,10.,20. };
  27.     static doublereal eps = 1e-12;
  28.  
  29.     /* System generated locals */
  30.     doublereal d_1, d_2, d_3;
  31.  
  32.     /* Builtin functions */
  33.     double d_lg10(), exp();
  34.  
  35.     /* Local variables */
  36.     static doublereal a, b;
  37.     static integer i;
  38.     static doublereal xfact;
  39.     static integer m1, m2, np, nx;
  40.     static doublereal fm1, fm2;
  41.     static integer nal;
  42.  
  43. /*<       implicit double precision (a-h,o-z) >*/
  44.  
  45. /*     this routine determines the 'optimal' scale to use for the plot of 
  46. */
  47. /* some output variable. */
  48.  
  49.  
  50. /*  adapted from algorithm 463 of 'collected algorithms of the cacm' */
  51.  
  52. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  53. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  54. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  55. /*<      2   pivtol,pivrel >*/
  56. /*<       integer xxor >*/
  57. /*<       dimension vint(5) >*/
  58. /*<       data vint / 1.0d0,2.0d0,5.0d0,10.0d0,20.0d0 / >*/
  59. /*<       data eps / 1.0d-12 / >*/
  60.  
  61.  
  62. /* ...  trap too-small data spread */
  63. /* *********************************************************** */
  64. /*  temporily check 'equality' this way */
  65. /*<       if(xmin.eq.0.0d0.and.xmax.eq.0.0d0) go to 4 >*/
  66.     if (*xmin == 0. && *xmax == 0.) {
  67.     goto L4;
  68.     }
  69. /*<       if(dabs((xmax-xmin)/dmax1(dabs(xmin),dabs(xmax))).ge.1.0d-4) >*/
  70. /*<      1  go to 10 >*/
  71. /* Computing MAX */
  72.     d_2 = abs(*xmin), d_3 = abs(*xmax);
  73.     if ((d_1 = (*xmax - *xmin) / max(d_3,d_2), abs(d_1)) >= 1e-4) {
  74.     goto L10;
  75.     }
  76. /*<     4 continue >*/
  77. L4:
  78. /*<       if (xmin.ge.0.0d0) go to 5 >*/
  79.     if (*xmin >= 0.) {
  80.     goto L5;
  81.     }
  82. /*<       xmax=0.5d0*xmin+eps >*/
  83.     *xmax = *xmin * .5 + eps;
  84. /*<       xmin=1.5d0*xmin-eps >*/
  85.     *xmin = *xmin * 1.5 - eps;
  86. /*<       go to 10 >*/
  87.     goto L10;
  88. /*<     5 xmax=1.5d0*xmin+eps >*/
  89. L5:
  90.     *xmax = *xmin * 1.5 + eps;
  91. /*<       xmin=0.5d0*xmin-eps >*/
  92.     *xmin = *xmin * .5 - eps;
  93. /* ...  find approximate interval size, normalized to [1,10] */
  94. /*<    10 a=(xmax-xmin)/dble(n) >*/
  95. L10:
  96.     a = (*xmax - *xmin) / (doublereal) (*n);
  97. /*<       nal=idint(dlog10(a)) >*/
  98.     nal = (integer) d_lg10(&a);
  99. /*<       if (a.lt.1.0d0) nal=nal-1 >*/
  100.     if (a < 1.) {
  101.     --nal;
  102.     }
  103. /*<       xfact=dexp(xlog10*dble(nal)) >*/
  104.     xfact = exp(knstnt_1.xlog10 * (doublereal) nal);
  105. /*<       b=a/xfact >*/
  106.     b = a / xfact;
  107. /* ...  find closest permissible interval size */
  108. /*<       do 20 i=1,3 >*/
  109.     for (i = 1; i <= 3; ++i) {
  110. /*<       if (b.lt.(vint(i)+eps)) go to 30 >*/
  111.     if (b < vint[i - 1] + eps) {
  112.         goto L30;
  113.     }
  114. /*<    20 continue >*/
  115. /* L20: */
  116.     }
  117. /*<       i=4 >*/
  118.     i = 4;
  119. /* ...  compute interval size */
  120. /*<    30 del=vint(i)*xfact >*/
  121. L30:
  122.     *del = vint[i - 1] * xfact;
  123. /*<       fm1=xmin/del >*/
  124.     fm1 = *xmin / *del;
  125. /*<       m1=fm1 >*/
  126.     m1 = (integer) fm1;
  127. /*<       if (fm1.lt.0.0d0) m1=m1-1 >*/
  128.     if (fm1 < 0.) {
  129.     --m1;
  130.     }
  131. /*<       if (dabs(dble(m1)+1.0d0-fm1).lt.eps) m1=m1+1 >*/
  132.     if ((d_1 = (doublereal) m1 + 1. - fm1, abs(d_1)) < eps) {
  133.     ++m1;
  134.     }
  135. /* ...  compute new maximum and minimum limits */
  136. /*<       xminp=del*dble(m1) >*/
  137.     *xminp = *del * (doublereal) m1;
  138. /*<       fm2=xmax/del >*/
  139.     fm2 = *xmax / *del;
  140. /*<       m2=fm2+1.0d0 >*/
  141.     m2 = (integer) (fm2 + 1.);
  142. /*<       if (fm2.lt.(-1.0d0)) m2=m2-1 >*/
  143.     if (fm2 < -1.) {
  144.     --m2;
  145.     }
  146. /*<       if (dabs(fm2+1.0d0-dble(m2)).lt.eps) m2=m2-1 >*/
  147.     if ((d_1 = fm2 + 1. - (doublereal) m2, abs(d_1)) < eps) {
  148.     --m2;
  149.     }
  150. /*<       xmaxp=del*dble(m2) >*/
  151.     *xmaxp = *del * (doublereal) m2;
  152. /*<       np=m2-m1 >*/
  153.     np = m2 - m1;
  154. /* ...  check whether another loop required */
  155. /*<       if (np.le.n) go to 40 >*/
  156.     if (np <= *n) {
  157.     goto L40;
  158.     }
  159. /*<       i=i+1 >*/
  160.     ++i;
  161. /*<       go to 30 >*/
  162.     goto L30;
  163. /* ...  do final adjustments and correct for roundoff error(s) */
  164. /*<    40 nx=(n-np)/2 >*/
  165. L40:
  166.     nx = (*n - np) / 2;
  167. /*<       xminp=dmin1(xmin,xminp-dble(nx)*del) >*/
  168. /* Computing MAX */
  169.     d_1 = *xmin, d_2 = *xminp - (doublereal) nx * *del;
  170.     *xminp = min(d_2,d_1);
  171. /*<       xmaxp=dmax1(xmax,xminp+dble(n)*del) >*/
  172. /* Computing MAX */
  173.     d_1 = *xmax, d_2 = *xminp + (doublereal) (*n) * *del;
  174.     *xmaxp = max(d_2,d_1);
  175. /*<       return >*/
  176.     return 0;
  177. /*<       end >*/
  178. } /* scale_ */
  179.  
  180.